home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 47.7z / BS1 part 47 / HiSoft BASIC v1.04 (1989)(HiSoft)(Disk 2 of 2)[h Band].7z / HiSoft BASIC v1.04 (1989)(HiSoft)(Disk 2 of 2)[h Band].adf / graphics / picsave.bas < prev    next >
Encoding:
BASIC Source File  |  1988-12-02  |  2.1 KB  |  82 lines
  1. SUB picsave (Nam$,WindowNr%,ArrayYN%) STATIC
  2.   IF ArrayYN%=1 THEN SHARED Colors%()
  3.   IF ArrayYN%=0 THEN
  4.     IF Colors%(0,0)<>2 THEN ERASE Colors% : DIM Colors%(31,2)
  5.     RESTORE ColorTable
  6.     FOR x=0 TO 31
  7.       READ Colors%(x,0),Colors%(x,1),Colors%(x,2)
  8.     NEXT x
  9.   ColorTable:  
  10.     DATA 2,3,10, 15,15,15, 0,0,0, 15,8,0
  11.     DATA 0,0,15, 15,0,15, 0,15,15, 15,15,15
  12.     DATA 6,1,1, 14,5,0, 8,15,0, 14,11,0
  13.     DATA 5,5,15, 9,0,15, 0,15,9, 12,12,12
  14.     DATA 0,0,0, 13,0,0, 0,0,0, 15,12,10
  15.     DATA 4,4,4, 5,5,5, 6,6,6, 7,7,7
  16.     DATA 8,8,8, 9,9,9, 10,10,10, 11,11,11
  17.     DATA 12,12,12, 13,13,13, 14,14,14, 15,15,15
  18.   END IF
  19.   IF Nam$="" THEN EXIT SUB
  20.   AltWindowNr=WINDOW(1)
  21.   WINDOW WindowNr%
  22.   Wide=WINDOW(2)
  23.     IF Wide>320 THEN
  24.       Wide=640
  25.       Resolution=2
  26.       Planes=16000
  27.     ELSE
  28.       Wide=320
  29.       Resolution=1
  30.       Planes=8000
  31.     END IF
  32.   Height=WINDOW(3)
  33.     IF Height>200 THEN
  34.       Height=400
  35.       Planes=Planes*2
  36.       Resolution=Resolution+2
  37.     ELSE
  38.       Height=200
  39.     END IF
  40.   Colors=LOG(WINDOW(6)+1)/LOG(2)
  41.  
  42.   OPEN Nam$ FOR OUTPUT AS 1 LEN=FRE(0)-500
  43.     PRINT #1,"FORM";
  44.     PRINT #1,MKL$(156+Planes*Colors);
  45.     PRINT #1,"ILBM";
  46.     PRINT #1,"BMHD";MKL$(20);
  47.     PRINT #1,MKI$(Wide);MKI$(Height);
  48.     PRINT #1,MKL$(0);
  49.     PRINT #1,CHR$(Colors);
  50.     PRINT #1,CHR$(0);MKI$(0);MKI$(0);
  51.     PRINT #1,CHR$(10);CHR$(11);
  52.     PRINT #1,MKI$(Wide);MKI$(Height);
  53.     
  54.     PRINT #1,"CMAP";MKL$(96); 
  55.     FOR x=0 TO 31
  56.       PRINT #1,CHR$(Colors%(x,0)*16);
  57.       PRINT #1,CHR$(Colors%(x,1)*16);
  58.       PRINT #1,CHR$(Colors%(x,2)*16);
  59.     NEXT x
  60.     
  61.     PRINT #1,"BODY";MKL$(Planes*Colors);
  62.     Addr=PEEKL(WINDOW(8)+4)+8
  63.     FOR x=0 TO Colors-1
  64.       PlaneAddr(x)=PEEKL(Addr+4*x)
  65.     NEXT x
  66.     FOR y1=0 TO Height-1
  67.       FOR b=0 TO Colors-1
  68.         FOR x1=0 TO (Wide/32)-1 
  69.           PRINT#1,MKL$(PEEKL(PlaneAddr(b)+4*x1+(Wide/8)*y1));
  70.         NEXT x1
  71.       NEXT b
  72.       PAddr=PlaneAddr(0)+(Wide/8)*y1
  73.       POKE PAddr,PEEK(PAddr) AND 63
  74.       POKE PAddr+Wide/8-1,PEEK(PAddr+Wide/8-1) AND 252
  75.     NEXT y1
  76.     
  77.     PRINT #1,"CAMG";MKL$(4);
  78.     PRINT #1,MKL$(16384);
  79.   CLOSE 1
  80.   WINDOW AltWindowNr  
  81. END SUB
  82.